home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - ProDOS / PRO064.dsk / ADD.FILE.bas < prev    next >
BASIC Source File  |  2012-02-16  |  8KB  |  193 lines
  1. 2000 D$ =  CHR$(4): GOTO 2020
  2. 2006  IF (SL <8)  AND (DR <3)  THEN  GOTO 2012
  3. 2007 HP$ = PD$: RETURN 
  4. 2012  PRINT D$;"PREFIX,D";DR;",S";SL
  5. 2013  PRINT D$;"PREFIX"
  6. 2014  INPUT HP$
  7. 2015  RETURN 
  8. 2020  GOSUB 2006
  9. 2030  PRINT D$;"OPEN";HP$;",TDIR"
  10. 2040  PRINT D$;"READ";HP$
  11. 2050 J = 1
  12. 2060  INPUT T1$
  13. 2070  INPUT T2$
  14. 2080  INPUT T3$
  15. 2090  INPUT T4$: IF  MID$ (T4$,18,3) < >"TXT"  THEN 2130
  16. 2100 W$(J) =  MID$ (T4$,2,14)
  17. 2120 J = J +1
  18. 2130  IF T4$ < >""  THEN  GOTO 2090
  19. 2140  PRINT D$;"CLOSE";HP$
  20. 2145  IF J = 1  THEN W$(1) = "": RETURN 
  21. 2150 T1 = J -1:PM$(8,0) = "READ DATA FILE :"
  22. 2165 A = 2:M = 8:HT = 10:VS = 0
  23. 2170  FOR J = 0 TO T1  STEP 8
  24. 2180  FOR K = 1 TO 8
  25. 2190  IF J +K >T1  THEN  GOTO 2205
  26. 2200 PM$(M,K) = W$(J +K): NEXT K
  27. 2205 MN(8) = K -1: IF T1 >8  THEN MN(8) = K:PM$(8,K) = "* SEE MORE FILE NAMES *"
  28. 2207  IF T1 >8  AND K = 1  THEN  GOTO 2240
  29. 2209  HOME :VS = 0
  30. 2210 JS = J: GOSUB 6000:J = JS
  31. 2220  IF CV = 27  THEN  POP : GOTO 11140
  32. 2230  IF CV <MN(8)  THEN CV = CV +J: RETURN 
  33. 2235  IF T1 <9  AND CV <MN(8) +1  THEN CV = CV +J: RETURN 
  34. 2240  NEXT J: GOTO 2165
  35. 6000  GOTO 6200
  36. 6100  PRINT  CHR$(24): INVERSE :T = CV -VS: IF A >1  THEN  GOSUB 6160: RETURN 
  37. 6110  GOSUB 6170: RETURN 
  38. 6130  HTAB HT -3: VTAB CV: PRINT " ";:T = CV -VS: IF A >1  THEN  GOSUB 6160: RETURN 
  39. 6140  GOSUB 6170: RETURN 
  40. 6160  HTAB HT: VTAB VS +T: PRINT "(";T +1;")";" ";PM$(M,T +1);: NORMAL : CALL 64668: RETURN 
  41. 6170  HTAB HT: VTAB VS +T: PRINT "("; LEFT$(PM$(M,T +1),A);")";" ";PM$(M,T +1);: NORMAL : CALL 64668: RETURN 
  42. 6200  IF VS < >0  THEN  HTAB 1: VTAB 1: PRINT MS$(M): GOTO 6240
  43. 6220  HOME : PRINT MS$(M):VS =  INT(((18 -MN(M))/2) +6): VTAB VS -3: PRINT PM$(M,0)
  44. 6240 T = 0: FOR J = 1 TO MN(M): IF A >1  THEN  GOSUB 6160: GOTO 6290
  45. 6280  GOSUB 6170
  46. 6290 T = T +1: NEXT J
  47. 6320  IF G(M) >0  AND G(M) <25  THEN  VTAB G(M):CV = G(M): GOTO 6360
  48. 6350  VTAB VS:CV = VS
  49. 6360  GOSUB 6370: GOTO 6760
  50. 6370  HTAB HT -3:
  51. 6400  GOSUB 6100: WAIT  -16384,128:Z$ =  CHR$( PEEK( -16384) -128): POKE  -16368,0
  52. 6450  IF Z$ =  CHR$(27)  THEN CV = 27: RETURN 
  53. 6460  IF Z$ =  CHR$(13)  THEN  RETURN 
  54. 6480  IF Z$ =  CHR$(11)  THEN  GOSUB 6130:CV = CV -1: GOTO 6690
  55. 6490  IF Z$ =  CHR$(21)  THEN  GOSUB 6130:CV = CV -1: GOTO 6690
  56. 6500  IF Z$ =  CHR$(10)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  57. 6510  IF Z$ =  CHR$(32)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  58. 6520  IF Z$ =  CHR$(08)  THEN  GOSUB 6130:CV = CV +1: GOTO 6690
  59. 6540  GOSUB 6130:
  60. 6550 T = 0: FOR J = 1 TO MN(M): IF Z$ =  LEFT$(PM$(M,J),1)  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  61. 6580  IF Z$ =  CHR$( ASC( LEFT$(PM$(M,J),1)) +32)  THEN  GOTO 6600
  62. 6590  GOTO 6610
  63. 6600  IF  ASC(Z$) >96  AND  ASC(Z$) <123  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  64. 6610  IF A >1  AND  VAL(Z$) = J  THEN CV = VS +T: GOSUB 6100: FOR DQ = 1 TO 200: NEXT DQ: RETURN 
  65. 6620 T = T +1: NEXT J
  66. 6650 CV = VS: VTAB VS: HTAB HT -3: GOTO 6400
  67. 6690  IF CV >(VS +MN(M) -1)  THEN CV = VS
  68. 6700  IF CV <VS  THEN CV = (VS +MN(M) -1)
  69. 6720  VTAB CV: HTAB HT -3: GOTO 6400
  70. 6760  IF M <8  THEN G(M) = CV
  71. 6770  IF CV = 27  THEN  RETURN 
  72. 6780  GOSUB 6130:T = 0: FOR J = VS TO (VS +MN(M) -1):T = T +1: IF CV = J  THEN CV = T
  73. 6790  NEXT J: RETURN 
  74. 9997  REM 
  75. 9998  REM   **************   CREATE NEW FILE  *************
  76. 9999  REM 
  77. 10000  HOME : VTAB 8: HTAB 8: PRINT "IF YOU CONTINUE, ANY DATA "
  78. 10005  VTAB 10: HTAB 8: PRINT "IN MEMORY WILL BE ERASED"
  79. 10020  VTAB 16: HTAB 2: PRINT "PRESS ESC TO QUIT - SPACE TO CONTINUE ";
  80. 10025  GET Z$
  81. 10030  IF Z$ =  CHR$(27)  THEN  GOTO 32000
  82. 10050 NP = 0:A$(1) = "":B$(1) = "":C$(1) = "":CC$(1) = "":E$(1) = ""
  83. 10060  PRINT  CHR$(4);"FRE"
  84. 10070  GOTO 12000
  85. 10997  REM 
  86. 10998  REM    ***********   READ DATA FROM DISK   ***********
  87. 10999  REM 
  88. 11000  HOME : IF (DR <3)  THEN  GOSUB 20000
  89. 11001  IF (DR >2)  THEN  GOSUB 22000
  90. 11002  IF Z$ =  CHR$(27)  THEN  GOTO 32000
  91. 11003  IF Z$ =  CHR$(27)  THEN  GOTO 32000
  92. 11004  IF (DR <3)  AND (CODE$ = "ERROR")  THEN  GOTO 11000
  93. 11005  IF (DR >2)  AND (CODE$ = "ERROR")  THEN  GOTO 11000
  94. 11009  IF NP% < >1  THEN  GOTO 11065
  95. 11010  HOME : VTAB 10: HTAB 8: PRINT "YOUR DATA HAS BEEN ALTERED ": HTAB 8: PRINT "SINCE YOU SAVED TO DISK ": PRINT : HTAB 8: PRINT "DO YOU WISH TO SAVE YOUR": HTAB 8: PRINT "PRESENT DATA TO DISK ? ";: GET Z$
  96. 11020  IF Z$ = "Y"  OR Z$ = "y"  THEN  GOTO 15000
  97. 11065  GOSUB 2020
  98. 11070  IF W$(1) = ""  THEN  HOME : VTAB 10: PRINT "THERE ARE NO TEXT FILES ": PRINT "ON THIS DISK": FOR J = 1 TO 1600: NEXT : GOTO 11140
  99. 11080 WA$ = W$(CV)
  100. 11085 W2$ = HP$ +W$(CV)
  101. 11090  PRINT D$;"OPEN";W2$
  102. 11100  PRINT D$;"READ";W2$
  103. 11110  INPUT NP
  104. 11120  FOR J = 1 TO NP: CALL 39169,A$(J): CALL 39169,SA$(J): CALL 39169,B$(J): CALL 39169,SB$(J): CALL 39169,C$(J): CALL 39169,CC$(J): CALL 39169,E$(J): NEXT 
  105. 11130  PRINT D$;"CLOSE";W2$
  106. 11140 NP% = 0
  107. 11150  HOME 
  108. 11160  IF MA >47  THEN  PRINT D$;"PREFIX /RAM/": GOTO 32000
  109. 11170  PRINT D$;"PREFIX ";PR$: GOTO 32000
  110. 12000  PRINT  CHR$(4);"CHAIN ADD.ENTER,@12000"
  111. 14997  REM 
  112. 14998  REM    ***********   SAVE DATA ON DISK   *************
  113. 14999  REM 
  114. 15000  HOME : GOSUB 20000: IF CODE$ = "ERROR"  THEN  GOTO 15000
  115. 15002  IF Z$ =  CHR$(27)  THEN  GOTO 32000
  116. 15003  HOME : PRINT : IF WA$ = ""  THEN  GOTO 15040
  117. 15005  VTAB 1: HTAB 1: PRINT "ESC TO QUIT"
  118. 15010  VTAB 10: PRINT "CURRENT  FILE  :  ";WA$
  119. 15020  VTAB 12: PRINT "SAVE UNDER CURRENT FILE NAME ? ";: GET Z$: PRINT Z$;
  120. 15025  IF Z$ =  CHR$(27)  THEN  GOTO 15220
  121. 15030  IF Z$ = "Y"  OR Z$ = "y"  THEN  GOTO 15130
  122. 15035  HOME 
  123. 15040  VTAB 12: PRINT "DATA FILE NAME:  ": VTAB 2: PRINT "ENTER C FOR A CATALOG": VTAB 3: PRINT "ENTER Q TO QUIT"
  124. 15050  VTAB 12: HTAB 19: INPUT "";Z$
  125. 15060  IF Z$ = "Q" GOTO 15220
  126. 15070  IF Z$ = "q" GOTO 15220
  127. 15080  IF Z$ = "C" GOTO 15110
  128. 15090  IF Z$ = "c" GOTO 15110
  129. 15091  IF  LEN(Z$) <2  THEN  PRINT : PRINT : PRINT : PRINT "LENGTH OF NAME MUST BE GREATER THAN 1";: CALL 64668: GOTO 15050
  130. 15092  IF  ASC(Z$) >90  AND  ASC(Z$) <97  THEN  GOTO 15096
  131. 15093  IF  ASC(Z$) <65  OR  ASC(Z$) >122  THEN  GOTO 15096
  132. 15094  GOTO 15100
  133. 15096  PRINT : PRINT : PRINT : PRINT "FILE NAME MUST BEGIN WITH A LETTER  ";: CALL 64668: PRINT 
  134. 15097  PRINT : PRINT "PLEASE DO NOT USE CHARACTERS OTHER THAN";: CALL 64668: PRINT : PRINT :: PRINT "LETTERS,NUMBERS OR PERIODS";: CALL 64668: GOTO 15050
  135. 15100 WA$ = Z$: GOTO 15130
  136. 15110  GOSUB 2006: HOME : PRINT  CHR$(4);"CAT ";HP$
  137. 15120  PRINT "PRESS A KEY TO CONTINUE";: GET Z$: GOTO 15035
  138. 15130  GOSUB 2006:W2$ = HP$ +WA$
  139. 15135  HOME : VTAB 10: PRINT "    SAVING   ";W2$
  140. 15140 D$ =  CHR$(4)
  141. 15150  IF A$(0) = ""  AND B$(0) = ""  AND A$(1) = ""  AND B$(1) = ""  THEN  VTAB 10: PRINT "  NO DATA IS IN MEMORY   ";: GET Z$: GOTO 32000
  142. 15160  PRINT D$;"OPEN";W2$
  143. 15170  PRINT D$;"WRITE";W2$
  144. 15180  PRINT NP
  145. 15190  FOR J = 1 TO NP: PRINT A$(J): PRINT SA$(J): PRINT B$(J): PRINT SB$(J): PRINT C$(J): PRINT CC$(J): PRINT E$(J): NEXT 
  146. 15200  PRINT D$;"CLOSE";W2$
  147. 15210 NP% = 0
  148. 15220  HOME 
  149. 15230  IF MA >47  THEN  PRINT D$;"PREFIX /RAM/": GOTO 32000
  150. 15240  PRINT D$;"PREFIX ";PR$: GOTO 32000
  151. 20000 CODE$ = ""
  152. 20010  IF DR = 1  THEN BT = 16 *SL
  153. 20020  IF DR = 2  THEN BT = (16 *SL) +128
  154. 20030  POKE 867,BT
  155. 20040  CALL 870
  156. 20050 PK =  PEEK(850)
  157. 20060 ER = (PK/16 - INT(PK/16)) *16
  158. 20070  IF ER = 0  THEN  VTAB 10: HTAB 4: PRINT "I/O ERROR, PLEASE CHECK DRIVE.  ";:CODE$ = "ERROR  ": GET Z$: RETURN 
  159. 20080  FOR I = 851 TO 865
  160. 20090 CODE$ = CODE$ + CHR$( PEEK(I))
  161. 20100  NEXT I
  162. 20110  RETURN 
  163. 21010 CODE$ = ""
  164. 21020  IF DI = 1  THEN BT = 16 *SI
  165. 21030  IF DI = 2  THEN BT = (16 *SI) +128
  166. 21040  POKE 867,BT
  167. 21050  CALL 870
  168. 21060 PK =  PEEK(850)
  169. 21070 ER = (PK/16 - INT(PK/16)) *16
  170. 21080  IF ER = 0  THEN CODE$ = "ERROR": RETURN 
  171. 21090  FOR I = 851 TO 865
  172. 21100 CODE$ = CODE$ + CHR$( PEEK(I))
  173. 21110  NEXT I
  174. 21120  RETURN 
  175. 22000  FOR DI = 1 TO 2
  176. 22010  FOR SI = 7 TO 1  STEP  -1
  177. 22020  GOSUB 21010
  178. 22022 HP$ = ""
  179. 22023  FOR J = 2 TO  LEN(PD$)
  180. 22024  IF  MID$ (PD$,J,1) = "/"  THEN J =  LEN(PD$): GOTO 22035
  181. 22025 HP$ = HP$ + MID$ (PD$,J,1)
  182. 22035  NEXT J
  183. 22037  IF  MID$ (CODE$,1, LEN(HP$)) = HP$  THEN  RETURN 
  184. 22040  NEXT SI
  185. 22050  NEXT DI
  186. 22060 CODE$ = "ERROR"
  187. 22065  VTAB 1: PRINT "PRESS ESC TO GO BACK"
  188. 22070  VTAB 10: HTAB 7: PRINT "PLEASE INSERT DATA DISK     ": VTAB 12: HTAB 7: PRINT "PRESS A KEY TO CONTINUE  ";: GET Z$
  189. 22080  RETURN 
  190. 32000  HOME 
  191. 32010  PRINT  CHR$(4);"CHAIN ADD.ENTER,@32000"
  192. 40000  PRINT  CHR$(4);"SAVE /RAM/ADD.FILE"
  193. 40100  PRINT  CHR$(4);"CHAIN ADD.SORT,@40000"